{*******************************************************}
{                                                       }
{       Turbo Pascal for Windows                        }
{       Standard windows unit for ObjectWindows         }
{       Modified for CARTO-PC - JMM - 13/07/92          }
{                                                       }
{       Copyright (c) 1991 Borland International        }
{                                                       }
{*******************************************************}

unit SCmpWnds;

interface

uses
     SysUtils, Messages,
     Objects, WinTypes, WinProcs, WinCrt, WinDos,
     OStdDlgs, Strings, OWindows, ODialogs,
     CARTOCmds, ChildWnds, CartoDlg, Imgdlgs, wcanobj,
     tit_win,get_win,gmuf_win,aux_win,outl_win,coul_win,
     wtstdhdr, wtarray, wtgsubs, wtchart, wrtdisp,
     WrtSpecM;

{--------------------------------------------------}
{ Globals                                        }
{--------------------------------------------------}

type
   TCOMP_C  =  array[1..compar_s] of TPOINTER_C;

const
  id_Compar  = 121;
  id_Modlist = 122;
  id_Class   = 123;

  id_Band    = 124;   (* 124, 125, 126 *)


{ T8ChWindow ------------------------------------------------------ }

type
  P8ChWindow = ^T8ChWindow;
  T8ChWindow = object(TNoIconWindow)
    RTChart : PRTChart;
    nband       : integer;                    (* Ici := canmax_s *)
    nbmod       : integer;                    (* Ici := compar_s *)
    nband_u     : integer;
    nbmod_u     : integer;
    nbclass     : boolean;
    nmodsel     : integer;
    band_name   : array[1..canmax_s] of st8;

    xconv_cent   : TPOINTER_C;
    yconv_spec   : array[1..10] of TCOMP_C;
    ydata_spec   : TPOINTER_C;
    xrms_intv    : array[1..canmax_s] of TPOINTER_C;
    yrms_intv    : array[1..canmax_s] of TPOINTER_C;

    Max_Amp  : RealType;
    Lg_Inf   : RealType;
    Lg_Sup   : RealType;

    titre_s     : array[1..compar_s] of string;
    titre_c     : string;

    constructor Init(AParent: PWindowsObject; Objecttype:integer;
                             MyTitle:string);
    destructor Done;  virtual;
    procedure Draw;
    procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
    PROCEDURE MetaFileSaveAs;
    PROCEDURE ClipSaveAs;
    procedure SetSize(GetMaxX,GetMaxY:integer);
  end;

{ declares TAaeroDiag, a T7ChWindow descendant }
Type
  PComparDiag = ^TComparDiag;
  TComparDiag = Object(T8ChWindow)
     constructor Init(AParent: PWindowsObject; ObjectType: integer);
     function GetClassName: PChar; virtual;
     procedure GetWindowClass(var WC: TWndClass); virtual;
     function Spec_Compar:integer;
     function Spec_New:integer;
     function Spec_Open(var In_File:String):integer;
     function Spec_Save(var Out_File:String):integer;
     function Class_Compar:integer;
     procedure ChangeScale;
  end;

type
  PComparDlg = ^TComparDlg;
  TComparDlg = OBJECT(TTeraDlgWindow)
    ComparDiag         : PComparDiag;
    CONSTRUCTOR Init(AParent : PWindowsObject; hc:integer; AName : PChar);
    destructor Done; virtual;
    procedure SetupWindow; virtual;
    function GetAttr_W:integer;
    function GetAttr_H:integer;
    procedure Draw;
    procedure Spec_Compar;
    procedure Spec_New;
    function  Spec_Open(var In_File:String):integer;
    function  Spec_Save(var Out_File:String):integer;
    procedure Class_Compar;
    procedure ChangeScale;
    PROCEDURE MetaFileSaveAs;
    PROCEDURE ClipSaveAs;
    procedure HandleListBoxMsg(var Msg: TMessage);
      virtual id_First + id_ModList;
  END;

{--------------------------------------------------}
{ TSCmpWindow }
{--------------------------------------------------}

  PSCmpWindow = ^TSCmpWindow;
  TSCmpWindow = object(TMyMDIChild)
    TXMax, TYMax : integer;
    Dial_Comp    : PComparDlg;
    Sim_File     : String;

    constructor Init(AParent: PWindowsObject;HObjType: Integer);
    destructor Done; virtual;
    procedure Paint(pDC: HDC; var PaintInfo: TPaintStruct); virtual;
    procedure GetWindowClass(var AWndClass: TWndClass); virtual;
    function  GetClassName: PChar; virtual;

    procedure Spec_Compar(var Msg: TMessage);
      virtual wm_First + wmSPECMOD_SCSEND;
    procedure Spec_New(var Msg: TMessage);
      virtual cm_First + cmSIM_NEW;
    procedure Spec_Open(var Msg: TMessage);
      virtual cm_First + cmSIM_OPEN;
    procedure Spec_Save(var Msg: TMessage);
      virtual cm_First + cmSIM_SAVE;
    procedure Spec_SaveAs(var Msg: TMessage);
      virtual cm_First + cmSIM_SAVEAS;
    procedure ChangeScale(var Msg: TMessage);
      virtual cm_First + cmSIM_CHSCL;

    procedure Class_Compar(var Msg: TMessage);
      virtual wm_First + wmSC_SCSEND;

    PROCEDURE cmFileSaveAs(VAR Msg : TMessage);
      Virtual cm_First + cmCM_OBJSAVE;
    PROCEDURE cmEditCopy(VAR Msg : TMessage);
      Virtual cm_First + cmCM_OBJCLIP;
  end;

IMPLEMENTATION

{ T8ChWindow ------------------------------------------------------ }

constructor T8ChWindow.Init(AParent: PWindowsObject; Objecttype:integer;
                             MyTitle:string);
var getMaxX,getMaxY : integer;
    i,j             : INTEGER;
    xreal           : realtype;
    l,k             : integer;
    xrange          : real;

label 999;

begin

   nbmod := compar_s; nband := canmax_s;
   nbmod_u := 0; nband_u := 0; nbclass := FALSE;
   nmodsel := 1;

   xconv_cent.adresse := nil;
   for k := 1 to 10 do
     for i := 1 to nbmod do yconv_spec[k,i].adresse := nil;
   ydata_spec.adresse := nil;
   for i := 1 to nband do xrms_intv[i].adresse := nil;
   for i := 1 to nband do yrms_intv[i].adresse := nil;

   TNoIconWindow.Init(AParent, ObjectType, MyTitle);
   if Status < 0 then begin Status := em_InvalidWindow; goto 999; end;

  Status := em_InvalidWindow;

  if not(xconv_cent.Creer(nband)) then goto 999;
  for k := 1 to 10 do
    for i := 1 to nbmod do
      if not(yconv_spec[k,i].Creer(nband)) then goto 999;
  if not(ydata_spec.Creer(nband)) then goto 999;
  for i := 1 to nband do
    if not(xrms_intv[i].Creer(2)) then goto 999;
  for i := 1 to nband do
    if not(yrms_intv[i].Creer(2)) then goto 999;

  (* Set initial lay_out *)
  Max_amp := 127.0;
  Lg_Inf := 0.0; Lg_Sup := 4.0;

  GetMaxX := 640;
  GetMaxY := 480;

  {* REINITIALIZE 2 R-T WINDOWS *}
  RTChart := New(PRTChart, Init(2,1,getMaxX,getMaxY));
  RTChart^.rtsetpercentwindow(RTChart^.rtstat^[1],0.10,0.10,0.90,0.90);
  RTChart^.rtsetwin2plotratio(RTChart^.rtstat^[1], 0.30,0.0,0.0,0.15);

  Status := 0;
999:end;

{ Dispose of the objects that this window object created.  There's
  no need to dispose the List pointer, since it will only point to
  one of these two objects which are being disposed by their
  primary pointers }
destructor T8ChWindow.Done;
var i,j,k : integer;
begin
  Dispose(RTChart, Done);
  xconv_cent.Detruire;
  for k := 1 to 10 do
    for i := 1 to nbmod do yconv_spec[k,i].Detruire;
  ydata_spec.Detruire;
  for i := 1 to nband do yrms_intv[i].Detruire;
  for i := 1 to nband do yrms_intv[i].Detruire;

  inherited Done;
end;

{ When the window is resized, scale the line list to fit the new
  window extent, or switch between full size and iconized window
  states.  }
procedure T8ChWindow.SetSize(GetMaxX,GetMaxY:integer);
var
    Xrange : real;
begin
  InvalidateRect(HWindow, nil, True);

  Dispose(RTChart, Done);
  {* REINITIALIZE 2 R-T WINDOWS *}
  RTChart := New(PRTChart, Init(2,1,getMaxX,getMaxY));
  RTChart^.rtsetpercentwindow(RTChart^.rtstat^[1],0.10,0.10,0.90,0.90);
  RTChart^.rtsetwin2plotratio(RTChart^.rtstat^[1], 0.30,0.0,0.0,0.15);

end;

procedure T8ChWindow.Draw;
var i,j,y_color : integer;
    xreal : double;
begin
  RTChart^.InitGraph;

  Lg_Sup := nband_u + 1;
  RTChart^.rtscaleplotarea(RTChart^.rtstat^[1], lg_inf, 0.0, lg_sup, Max_amp);
  RTChart^.rtsetxyintercepts(RTChart^.rtstat^[1],Lg_inf,0.0);

  RTChart^.setcolor(0);

  if nband_u <> 0 then
    for i := 1 to nband_u do begin
      xreal := i; xconv_cent.PutPntrReal(i-1, xreal);
      xrms_intv[i].PutPntrReal(0, xreal);
      xrms_intv[i].PutPntrReal(1, xreal);
    end;
  if nbmod_u <> 0 then begin
    for i := 1 to nbmod_u do
        RTChart^.rtlineplotdata(RTChart^.rtstat^[1], xconv_cent, yconv_spec[10,i], nband_u, 2, 0,1);
    RTChart^.rtlineplotdata(RTChart^.rtstat^[1], xconv_cent, yconv_spec[10,nmodsel], nband_u, 4, 0,2);
  end;
  if (nbclass) and (nband_u <> 0) then begin
    RTChart^.rtlineplotdata(RTChart^.rtstat^[1],
             xconv_cent, ydata_spec, nband_u, 12, 0,1);
    for j := 1 to nband_u do
      RTChart^.rtlineplotdata(RTChart^.rtstat^[1],
             xrms_intv[j], yrms_intv[j], 2, 12, 0,2);
  end;

  RTChart^.setcolor(0);
  RTChart^.rtdrawyaxis(RTChart^.rtstat^[1],16, 0);
  RTChart^.rtlabelyaxis(RTChart^.rtstat^[1],2, 0, 0);

  {* WIN1 Draw a tic on the x axis every 1.0 from the intercept,
     WIN1 i.e., 0.0, 1.0, 2.0, 3.0 etc up to nl+1.0 *}
(*  RTChart^.rtdrawxaxis(RTChart^.rtstat^[1],0.5,0);  *)

  RTChart^.rtdrawxaxis(RTChart^.rtstat^[1],1.0,0);
  RTChart^.rtlabelxaxis(RTChart^.rtstat^[1],1, 0,0);

  RTChart^.setcolor(0);
  {* WIN1, Display titles for the x and y axes *}
  Loadstring(HInstance, stW_STATTitCan+Lang, @MessageText, 79);
  Loadstring(HInstance, stW_STATTitAmp+Lang, @TitleText, 79);
  RTChart^.rttitlexaxis(RTChart^.rtstat^[1],StrPas(MessageText));
  RTChart^.rttitleyaxis(RTChart^.rtstat^[1],StrPas(TitleText));

  RTChart^.CloseGraph;
end;

{ When the window is resized, or some other window blots out part
  of our client area, redraw the entire line list.  The PaintDC
  is fetched before Paint is called and is released for us after
  Paint is finished. }
procedure T8ChWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var i,j,y_color : integer;
begin
  TWindow.Paint(PaintDC, PaintInfo);

{ Redraw the Graph. }

  RTChart^.WinDC := PaintDC;
  Draw;
end;

PROCEDURE T8ChWindow.MetaFileSaveAs;
VAR
    OldCur : hCursor;
    MyFileDialog : PBmpDialog;

    i : integer;
    hmf : THandle;


label 999;

BEGIN

    { .WMF file save }
    Loadstring(HInstance, stW_WMFSauvTit+Lang, @TitleText, 79);
    MyFileDialog := New(PBmpDialog,Init(@Self, PChar(sd_FileSave), @TitleText,
                    strcopy(path, '*.WMF')));
    IF MyFileDialog <> nil then
      BEGIN
        if MyFileDialog^.Execute <> id_Ok then goto 999;
        StrUpper(path);
        IF StrScan(path, '.') = NIL THEN StrCat(path, '.WMF');
        FileSearch(dest, path, '');

        IF Dest[0] <> #0 THEN BEGIN
        Loadstring(HInstance, stW_LaySavFex+Lang, @MessageText, 79);
          IF MessageBox(hWindow, MessageText, dest, mb_YesNo +
            mb_IconQuestion) <> IDYes THEN goto 999;
        END;

    with RTChart^ do begin

        OldCur := SetCursor(LoadCursor(0, idc_Wait));
        MetaFile := True; TxtH := 12; TxtW := 8;
        WinDC := CreateMetaFile(path);
        SetMapMode(WinDC, MM_ANISOTROPIC);
        SetWindowExt(WinDC,640,480);

        Draw;

        hmf := CloseMetaFile(WinDC);
        DeleteMetaFile(WinDC);
        MetaFile := False;
        SetCursor(OldCur);
   end;

       END;

999:END;

PROCEDURE T8ChWindow.ClipSaveAs;
VAR
    OldCur : hCursor;
    hmf : THandle;
    hGmem : THandle;
    lpMFP : ^TMETAFILEPICT;

BEGIN

  with RTChart^ do begin

        OldCur := SetCursor(LoadCursor(0, idc_Wait));
        MetaFile := True; TxtH := 12; TxtW := 8;
        WinDC := CreateMetaFile(NIL);
        SetMapMode(WinDC, MM_ANISOTROPIC);
        SetWindowExt(WinDC,640,480);

        Draw;

        hmf := CloseMetaFile(WinDC);
        hGmem := GlobalAlloc(gmem_Moveable OR gmem_ZeroInit,sizeof(TMETAFILEPICT));
        lpMFP := GlobalLock(hGmem);
        lpMFP^.mm := MM_ISOTROPIC;
        lpMFP^.xExt := 640;
        lpMFP^.xExt := 480;
        lpMFP^.hMF := hmf;
        OpenClipBoard(hWindow);
        EmptyClipBoard;
        SetClipBoardData(CF_METAFILEPICT, hGmem);
        CloseClipBoard;

        DeleteMetaFile(WinDC);
        MetaFile := False;
        SetCursor(OldCur);
  end;

END;

{ declares TComparDiag, a T8ChWindow descendant }
constructor TComparDiag.Init(AParent: PWindowsObject; ObjectType: integer);
var i : integer;
label 999;

begin

  Status := em_InvalidWindow;
  T8ChWindow.Init(AParent, ObjectType, ' ');
  if Status < 0 then begin
    Status := em_InvalidWindow;
    goto 999;
  end;
  Attr.Style := ws_Child or ws_Visible;
   for i := 1 to canmax_s do band_name[i] := '';
  Status := 0;
999:end;

function TComparDiag.GetClassName: PChar;
begin
  GetClassName := 'ComparDialog';
end;

procedure TComparDiag.GetWindowClass(var WC: TWndClass);
begin
  inherited GetWindowClass(WC);
  WC.hbrBackground := GetStockObject(White_Brush);
end;

function TComparDiag.Spec_Compar:integer;
var f_in : text;
  xreal : double;
  ligne : string;
  i,k: integer;
  nband_l : integer;
  scomp_band : array[1..canmax_s] of st8;
  nbmod_sent:integer;

label 999;
begin
  Spec_Compar := -1;
  for i := 1 to canmax_s do scomp_band[i] := '';
  if nbmod_u >= nbmod then begin
    Loadstring(HInstance, stW_SCompNom+Lang, @MessageText, 79);
    Loadstring(HInstance, stW_SCompTIT+Lang, @TitleText, 79);
    MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
    goto 999;
  end;

{$I-}
{JMM} assign(f_in,ExePath+'scompar.tvu');
{JMM} reset(f_in);
      ier := ioresult;
      if ier <> 0 then goto 999;

      readln(f_in,ligne);
      _nextpar(strw,ligne); val(strw, nbmod_sent, erreur);

      if nbmod_u + nbmod_sent >= nbmod then begin
        Loadstring(HInstance, stW_SCompNom+Lang, @MessageText, 79);
        Loadstring(HInstance, stW_SCompTIT+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        close(f_in);
        goto 999;
     end;

     for k := 1 to nbmod_sent do begin

       readln(f_in,S);  (* mod_name *)
       readln(f_in,ligne);
       _nextpar(strw,ligne); val(strw, nband_l, erreur);
       if erreur <> 0 then begin close(f_in); goto 999; end;
       if (nband_l < 1) or (nband_l > canmax_s) then begin close(f_in); goto 999; end;

       if nband_l = 1 then begin
         Loadstring(HInstance, stW_SCompCl1+Lang, @MessageText, 79);
         Loadstring(HInstance, stW_SCompTIT+Lang, @TitleText, 79);
         MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
         close(f_in);
         goto 999;
       end;

       if (nband_u = 0) then nband_u := nband_l;

       if nband_l <> nband_u then begin
         Loadstring(HInstance, stW_SCompNbc+Lang, @MessageText, 79);
         Loadstring(HInstance, stW_SCompTIT+Lang, @TitleText, 79);
         MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
         close(f_in);
         goto 999;
       end;

       nbmod_u := nbmod_u + 1;
       titre_s[nbmod_u] := copy(S,1,length(S));
       for i := 1 to nband_u do begin
         readln(f_in,ligne);
(*
    1     2     3       4        5      6      7       8        9       10    11
   WINF. WSUP. SUN_CST DIR_IRR SKY_IRR TRANSM SAT_RAD PATH_RAD OBJ_RAD  DC  SENSO
*)
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* WINF *)
         yconv_spec[1,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* SUP *)
         yconv_spec[2,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* SUN_CST *)
         yconv_spec[3,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* DIR_IRR *)
         yconv_spec[4,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* SKY_IRR *)
         yconv_spec[5,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* TRANSM *)
         yconv_spec[6,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* SAT_RAD *)
         yconv_spec[7,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* PATH_RAD *)
         yconv_spec[8,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne);  val(strw, xreal, erreur); (* OBJ_RAD *)
         yconv_spec[9,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne); val(strw, xreal, erreur);  (* DC *)
         yconv_spec[10,nbmod_u].PutPntrReal(i-1, xreal);
         _nextpar(strw,ligne); scomp_band[i] := copy(strw,1,8);(* Senso *)
       end;

       if nbmod_u = 1 then
         for i := 1 to nband_u do band_name[i] := scomp_band[i]

      end;

      close(f_in);
{$I+}
    for i := 1 to nband_u do begin
      if  (band_name[i] <> scomp_band[i]) then begin
        Loadstring(HInstance, stW_SCompNbs+Lang, @MessageText, 79);
        Loadstring(HInstance, stW_SCompTIT+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        nbmod_u := nbmod_u - 1;
        goto 999;
      end;
    end;

  Spec_Compar := 0;
999:end;

function TComparDiag.Spec_New:integer;
var i:integer;
begin
  nbmod_u := 0;
  for i := 1 to canmax_s do band_name[i] := '';
  Spec_New := 0;
end;

function  TComparDiag.Spec_Open(var In_File:String):integer;
var
    f_in,f_out : text;
    i,k : integer;
    _nmod,_nband : integer;
    xreal : real;
     _ligne:string;
label 999;
begin
  Spec_Open := -1;
{$I-}
{JMM} assign(f_in,In_File);
{JMM} reset(f_in);
      ier := ioresult;
      if ier <> 0 then goto 999;

{JMM} assign(f_out,ExePath+'scompar.tvu');
{JMM} rewrite(f_out);
      ier := ioresult;
      if ier <> 0 then goto 999;

      Readln(f_in,_ligne); Readln(f_in,_ligne); Readln(f_in,_ligne);
      Readln(f_in,_ligne); _nextpar(strw,_ligne); val(strw, _nmod, erreur);
      if _nmod > nbmod then begin
        Loadstring(HInstance, stW_SCompNom+Lang, @MessageText, 79);
        Loadstring(HInstance, stW_SCompTIT+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        close(f_in); close(f_out);
        goto 999;
      end;
      Readln(f_in,_ligne); Readln(f_in,_ligne);
       _nextpar(strw,_ligne); val(strw, _nband, erreur);
      if (nband_u <> 0) and (nband_u <> _nband) then begin
        Loadstring(HInstance, stW_SCompNbc+Lang, @MessageText, 79);
        Loadstring(HInstance, stW_SCompTIT+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        close(f_in); close(f_out);
        goto 999;
      end;

      nband_u := _nband; nbmod_u := _nmod;
      for i := 1 to nband_u do band_name[i] := '';
      for i := 1 to nband_u do begin
        Readln(f_in,_ligne); band_name[i] := copy(_ligne,1,8);
      end;
      Readln(f_in,_ligne); Readln(f_in,_ligne);

      for k := 1 to nbmod_u do begin
        Readln(f_in,_ligne);
        Readln(f_in,_ligne); writeln(f_out,_ligne);
        for i := 1 to nband_u do begin
          readln(f_in,_ligne);
(*
    1     2     3       4        5      6      7       8        9       10    11
   WINF. WSUP. SUN_CST DIR_IRR SKY_IRR TRANSM SAT_RAD PATH_RAD OBJ_RAD  DC  SENSO
*)
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* WINF *)
          yconv_spec[1,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* SUP *)
          yconv_spec[2,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* SUN_CST *)
          yconv_spec[3,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* DIR_IRR *)
          yconv_spec[4,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* SKY_IRR *)
          yconv_spec[5,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* TRANSM *)
          yconv_spec[6,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* SAT_RAD *)
          yconv_spec[7,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* PATH_RAD *)
          yconv_spec[8,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne);  val(strw, xreal, erreur); (* OBJ_RAD *)
          yconv_spec[9,k].PutPntrReal(i-1, xreal);
          _nextpar(strw,_ligne); val(strw, xreal, erreur);  (* DC *)
          yconv_spec[10,k].PutPntrReal(i-1, xreal);

        end;
      end;

      close(f_in); close(f_out);
{$I+}

  Spec_Open := 0;
999:end;

function TComparDiag.Spec_Save(var Out_File:String):integer;
var f_out,f_in : text;
    i,k : integer;
    x : real;
label 999;
begin
  Spec_Save := -1;
  if nbmod_u < 1 then goto 999;

{$I-}
{JMM} assign(f_in,ExePath+'scompar.tvu');
{JMM} reset(f_in);
      ier := ioresult;
      if ier <> 0 then goto 999;

{JMM} assign(f_out,Out_File);
{JMM} rewrite(f_out);
      ier := ioresult;
      if ier <> 0 then goto 999;
      writeln(f_out,'Spectral Simulation :');
      writeln(f_out,'*** Produced by TeraVue Spectral Simulator ***');
      writeln(f_out,'Number of spectra :');
      str(nbmod_u,strw); writeln(f_out,strw);
      writeln(f_out,'Number of bands :');
      str(nband_u,strw); writeln(f_out,strw);
      for i := 1 to nband_u do begin
        writeln(f_out,band_name[i]);
      end;
      Loadstring(HInstance, stW_SpecREST+Lang, MessageText, 79);
      writeln(f_out,strpas(Messagetext));
      Loadstring(HInstance, stW_SpecRESU+Lang, MessageText, 79);
      writeln(f_out,strpas(messagetext));

      for k := 1 to nbmod_u do begin
        str(k,strw);writeln(f_out,strw);
        readln(f_in,S); writeln(f_out,S);

        for i := 1 to nband_u do begin
(*
    1     2     3       4        5      6      7       8        9       10    11
   WINF. WSUP. SUN_CST DIR_IRR SKY_IRR TRANSM SAT_RAD PATH_RAD OBJ_RAD  DC  SENSO
*)

          x := yconv_spec[1,k].GetPntrReal(i-1);    (* WLINF *)
          str(x:5:3,strw); write(f_out,strw+' ');
          x := yconv_spec[2,k].GetPntrReal(i-1);    (* WLSUP *)
          str(x:5:3,strw); write(f_out,strw+' ');
          x := yconv_spec[3,k].GetPntrReal(i-1);    (* SEB *)
          str(x:7:1,strw); write(f_out,strw+' ');
          x := yconv_spec[4,k].GetPntrReal(i-1);    (* AINI^[2,1] *)
          str(x:7:1,strw); write(f_out,strw+' ');
          x := yconv_spec[5,k].GetPntrReal(i-1);    (* AINI^[2,2] *)
          str(x:7:1,strw); write(f_out,strw+' ');
          x := yconv_spec[6,k].GetPntrReal(i-1);    (* TGASM*100.0 *)
          str(x:4:1,strw); write(f_out,strw+' ');
          x := yconv_spec[7,k].GetPntrReal(i-1);    (* ALUMET *)
          str(x:7:1,strw); write(f_out,strw+' ');
          x := yconv_spec[8,k].GetPntrReal(i-1);    (* AINR^[2,1] *)
          str(x:7:1,strw); write(f_out,strw+' ');
          x := yconv_spec[9,k].GetPntrReal(i-1);    (* AINR^[2,3] *)
          str(x:7:1,strw); write(f_out,strw+' ');
          x := yconv_spec[10,k].GetPntrReal(i-1);    (* DC *)
          str(x:4:0,strw); write(f_out,strw+' ');
          writeln(f_out,band_name[i]);              (* SENSO *)

        end;
      end;


      close(f_out);
      close(f_in);
{$I+}

  Spec_Save := 0;
999:end;

function TComparDiag.Class_Compar:integer;
var f_in : text;
  xreal : double;
  ligne : string;
  nband_c : integer;
  i: integer;
label 999;
begin
  Class_Compar := -1;
{$I-}
{JMM} assign(f_in,ExePath+'ccompar.tvu');
{JMM} reset(f_in);
      ier := ioresult;
      if ier <> 0 then goto 999;
      readln(f_in,titre_c);  (* titre de classe *)
      readln(f_in,ligne);
      _nextpar(strw,ligne); val(strw, nband_c, erreur);
      if erreur <> 0 then begin close(f_in); goto 999; end;
      if (nband_c < 1) or (nband_c > canmax_s) then begin close(f_in); goto 999; end;

      if (nband_u = 0) then nband_u := nband_c;

      if nband_c <> nband_u then begin
        Loadstring(HInstance, stW_SCompNbc+Lang, @MessageText, 79);
        Loadstring(HInstance, stW_SCompTIT+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        close(f_in);
        goto 999;
      end;

      for i := 1 to nband_u do begin
        readln(f_in,ligne);
        _nextpar(strw,ligne); val(strw, xreal, erreur);
        ydata_spec.PutPntrReal(i-1, xreal);
        readln(f_in,ligne);
        _nextpar(strw,ligne); val(strw, xreal, erreur);
        yrms_intv[i].PutPntrReal(0, xreal);
        readln(f_in,ligne);
        _nextpar(strw,ligne); val(strw, xreal, erreur);
        yrms_intv[i].PutPntrReal(1, xreal);
      end;

      close(f_in);
      nbclass := TRUE;
{$I+}
  Class_Compar := 0;
999:end;

procedure TComparDiag.ChangeScale;
var
  StatCadrDlg:PStatCadrDlg;
  StatCadrData:TStatCadrData;
  Maxa, Lgi, Lgs : real;

label 999;
begin

  with StatCadrData do begin
    str(Max_amp:5:1,strw); StrPCopy(MaxAmp,strw);
  end;

  StatCadrDlg :=
          New(PStatCadrDlg, Init(@Self,hWCPC_STATCADR,'WCPC_STATCADR', @StatCadrData));

  Action := StatCadrDlg^.Execute;
  if (Action <> id_OK ) then goto 999;

  with StatCadrData do begin
    strw := StrPas(MaxAmp); val(strw, Maxa, ier);
  end;

  if (Maxa >= 1.0) or (Maxa <= 255.0) then Max_Amp := Maxa;

  {* WIN1 This displays the large window across the center of the screen *}
  InvalidateRect(hWindow, NIL, TRUE);

999:end;

CONSTRUCTOR TComparDlg.Init(AParent : PWindowsObject;
                        hc:integer; AName : PChar);
begin
    TTeraDlgWindow.Init(AParent, hc, AName);
    ComparDiag := nil;
    ComparDiag := New(PComparDiag, Init(@Self, SPECMO2));
end;

Destructor TComparDlg.Done;
begin
  if ComparDiag <> nil then Dispose(Compardiag, Done);
  inherited Done;
end;

procedure TComparDlg.SetupWindow;
var
  RDiag,RShade: TRect;
  GetMaxX,GetMaxY:Integer;
  InX, InY : Integer;
begin
  inherited SetupWindow;

  GetWindowRect(HWindow, RDiag);   { Prendre en compte le titre }
  GetWindowRect(GetDlgItem(HWindow, id_Compar),RShade);
  GetmaxX := (RShade.Right-2) - (RShade.Left+2) -1;
  GetMaxY := (RShade.Bottom-2) - (RShade.Top+2) -1;
  Inx := RShade.Left - RDiag.Left +2;
  InY := RShade.Top - RDiag.Top +2 ; { Rule of thumb }
  GetClientRect(GetDlgItem(HWindow, id_Compar), RShade);
  SetWindowPos(ComparDiag^.HWindow, 0, InX, InY, GetMaxX, GetMaxY,
               swp_NoZOrder or swp_NoActivate);
  ComparDiag^.SetSize(GetMaxX, GetMaxY);
  InvalidateRect(ComparDiag^.HWindow, nil, True);

end;

function TComparDlg.GetAttr_W:integer;
var DC      : HDC;
    TM      : TTEXTMETRIC;
    Font, OldFont : HFont;
    X : Real;
begin
  DC := GetDC(0);
  Font := GetStockObject(System_Font); OldFont := SelectObject(DC, Font);
  GetTextMetrics(DC, TM);
  X := 199.0 * TM.tmAveCharWidth / 4.0;
  GetAttr_W := round(X);
  SelectObject(DC, OldFont);
  ReleaseDC(0, DC);
end;

function TComparDlg.GetAttr_H:integer;
var DC      : HDC;
    TM      : TTEXTMETRIC;
    Font, OldFont : HFont;
    X : Real;
begin
  DC := GetDC(0);
  Font := GetStockObject(System_Font); OldFont := SelectObject(DC, Font);
  GetTextMetrics(DC, TM);
  X := 198.0 * TM.tmAveCharWidth / 4.0;
  GetAttr_H := round(X * 279.0 / 347.0);
  SelectObject(DC, OldFont);
  ReleaseDC(0, DC);
end;

procedure TComparDlg.Draw;
begin
  if ComparDiag <> nil then InvalidateRect(ComparDiag^.HWindow, nil, True);
end;

procedure TComparDlg.Spec_Compar;
var i :integer;
label 999;
begin
  if ComparDiag <> nil then begin
    ier :=ComparDiag^.Spec_Compar;
    if ier <> 0 then goto 999;
    for i := 1 to ComparDiag^.nbmod_u do begin
      strpcopy(Messagetext, ComparDiag^.Titre_s[i]);
      SendDlgItemMsg(id_ModList, lb_AddString, 0, Longint(@MessageText));
    end;
    for i := 1 to ComparDiag^.nband_u do begin
      strpcopy(Messagetext, ComparDiag^.band_name[i]);
      SendDlgItemMsg(id_Band+i-1, wm_SetText, 0, Longint(@MessageText));
    end;
  end;
999:end;

procedure TComparDlg.Spec_New;
var i:integer;
begin
  if ComparDiag <> nil then begin
    ier :=ComparDiag^.Spec_New;
    SendDlgItemMsg(id_ModList, lb_ResetContent, 0, 0);
  end;
  for i := 1 to ComparDiag^.nband_u do begin
    strpcopy(Messagetext, '');
    SendDlgItemMsg(id_Band+i-1, wm_SetText, 0, Longint(@MessageText));
  end;
end;

function TComparDlg.Spec_Open(var In_File:String):integer;
var f_in : text;
    i : integer;
     _ligne:string;
label 999;
begin
  Spec_Open := -1;
  if ComparDiag <> nil then
    ier :=ComparDiag^.Spec_Open(In_File) else goto 999;
  if ier <> 0 then goto 999;

{$I-}
{JMM} assign(f_in,ExePath+'scompar.tvu');
{JMM} reset(f_in);
      ier := ioresult;
      if ier <> 0 then goto 999;
      SendDlgItemMsg(id_ModList, lb_ResetContent, 0, 0);
      for i := 1 to ComparDiag^.nbmod_u do begin
        readln(f_in,_ligne); StrPcopy(MessageText, _ligne);
        SendDlgItemMsg(id_ModList, lb_AddString, 0, Longint(@MessageText));
      end;
      close(f_in);

{$I+}
    for i := 1 to ComparDiag^.nband_u do begin
      strpcopy(Messagetext, ComparDiag^.band_name[i]);
      SendDlgItemMsg(id_Band+i-1, wm_SetText, 0, Longint(@MessageText));
    end;
  Spec_Open := 0;
999:end;

function TComparDlg.Spec_Save(var Out_File:String):integer;
var f_out : text;
    ncount,i : integer;
label 999;
begin
  Spec_Save := -1;
  ncount := SendDlgItemMsg(id_ModList, lb_getCount, 0, 0);
  if ncount = 0 then goto 999;

{$I-}
{JMM} assign(f_out,ExePath+'scompar.tvu');
{JMM} rewrite(f_out);
      ier := ioresult;
      if ier <> 0 then goto 999;
      for i := 1 to ncount do begin
        SendDlgItemMsg(id_ModList, lb_getText, i-1, Longint(@MessageText));
        writeln(f_out,StrPas(Messagetext));
      end;
      close(f_out);
{$I+}

  if ComparDiag <> nil then
    ier :=ComparDiag^.Spec_Save(Out_File) else goto 999;
  Spec_Save := ier;
999:end;

procedure TComparDlg.ChangeScale;
begin if ComparDiag <> nil then ComparDiag^.ChangeScale; end;

procedure TComparDlg.Class_Compar;
label 999;
begin
  if ComparDiag <> nil then begin
    ier := ComparDiag^.Class_Compar;
    if ier <> 0 then goto 999;
    strpcopy(Messagetext, ComparDiag^.Titre_c);
    SendDlgItemMsg(id_Class, wm_SetText, 0, Longint(@MessageText));
  end;
999:end;

procedure TComparDlg.MetaFileSaveAs;
begin
  if ComparDiag <> nil then ComparDiag^.MetaFileSaveAs;
end;

procedure TComparDlg.ClipSaveAs;
begin
  if ComparDiag <> nil then ComparDiag^.ClipSaveAs;
end;

procedure TComparDlg.HandleListBoxMsg(var Msg: TMessage);
begin
  case Msg.LParamHi of

    lbn_DblClk : begin
      ComparDiag^.nmodsel := SendDlgItemMsg(id_ModList, lb_GetCurSel, 0, 0) + 1;
      if ComparDiag <> nil then InvalidateRect(ComparDiag^.HWindow, nil, True);
    end;

  end;

  DefWndProc(Msg);
end;

{--------------------------------------------------}
{ TSCmpWindow }
{--------------------------------------------------}

{ Constructor for a TSCmpWindow.  Initializes its data fields using
  passed parameters and default values. }
constructor TSCmpWindow.Init(AParent: PWindowsObject; HObjType: Integer);
label 999;
begin

  Dial_Comp := nil;
  TMyMDIChild.Init(AParent, HObjType, '');
  if Status < 0 then begin Status := em_InvalidWindow; goto 999; end;

  Status := em_InvalidWindow;
  Sim_File := '';

      Dial_Comp := New(PComparDlg, Init(@Self,hWDIAG1_COMPAR,'WDIAG1_COMPAR'));

  (* Calcul de la taille de la fenetre et verif objet *)
      TXMax := Dial_Comp^.GetAttr_W;
      TXMax := TxMax + 2*GetSystemMetrics(sm_CXFrame);    { MaxSize }
      TYMax := Dial_Comp^.GetAttr_H;
      TYMax := TYMax + GetSystemMetrics(sm_CYCaption) +
                  2*GetSystemMetrics(sm_CYFrame);
      Attr.W := TXMax;  Attr.H := TYmax;

   Status := 0;
999:end;

destructor TSCmpWindow.Done;
begin
  if Dial_Comp <> nil then Dispose(Dial_Comp, Done);
  Dial_Comp := nil;
  TMyMDIChild.Done;
end;

{Paints the window with text }
procedure TScmpWindow.Paint(pDC: HDC; var PaintInfo: TPaintStruct);
var
  i:integer;
  TR : TRect;
  op    : hPalette;
  bptr  : PChar;
  OldCur : hCursor;

    bitDC : hDC;
    ob    : hBitmap;
label 999;
begin
  if Status = em_InvalidWindow then goto 999;

  if Dial_Comp <> nil then Dial_Comp^.Draw;
  GetClientRect(HWindow, TR);
  if Dial_Comp <> nil then
    if Dial_Comp^.hWindow <> 0 then
      MoveWindow(Dial_Comp^.hWindow, TR.Left, TR.Top, TR.Right, TR.Bottom, True);

999:end;

procedure TSCmpWindow.GetWindowClass(var AWndClass: TWndClass);

begin
  TMyMDIChild.GetWindowClass(AWndClass);
  AWndClass.hIcon := LoadIcon(HInstance, 'ICON_HIST');
end;

function TScmpWindow.GetClassName: PChar;
begin
  GetClassName := 'SCmpWidow';
end;

procedure TScmpWindow.Spec_Compar(var Msg: TMessage);
begin if Dial_Comp <> nil then Dial_Comp^.Spec_Compar; end;

procedure TScmpWindow.Spec_New(var Msg: TMessage);
begin
  Sim_File := '';
  if Dial_Comp <> nil then begin
    Dial_Comp^.Spec_New;
    Dial_Comp^.Draw;
  end;
end;
procedure TScmpWindow.Spec_Open(var Msg: TMessage);
var
    MyFileDialog : PDXFDialog;
    i : integer;
label 999;
begin
  if Dial_Comp = nil then goto 999;
   { .SIM file selection }
    Loadstring(HInstance, stW_SIMSelTit+Lang, @TitleText, 79);
    MyFileDialog := New(PDxfDialog,Init(@Self, PChar(sd_FileOpen), @TitleText,
     StrCopy(MessageText, '*.SIM')));
    IF MyFileDialog <> nil then
      BEGIN
        if MyFileDialog^.Execute <> id_Ok then goto 999;
        AKFileName := StrPas(MessageText);
        For i := 1 to Length(AKFileName) do AKFileName[i] := UpCase(AKFileName[i]) ;
      END;
  ier := Dial_Comp^.Spec_Open(AKFileName);
  if ier = 0 then Sim_File := AKFileName;
999:end;

procedure TScmpWindow.Spec_Save(var Msg: TMessage);
label 999;
begin
  if Sim_File = '' then goto 999;
     LoadString(HInstance, stW_SCompUpd+Lang, @MessageText, 79);
     LoadString(HInstance, stW_SCompTit+Lang, @TitleText, 79);
     Action := MessageBox(HWindow,MessageText, TitleText,
                       mb_YesNoCancel or mb_IconQuestion);
     if Action <> id_Yes then goto 999;
  if Dial_Comp <> nil then ier := Dial_Comp^.Spec_Save(Sim_File);
999:end;

procedure TScmpWindow.Spec_SaveAs(var Msg: TMessage);
var SimPath : string;
    MyFileDialog : PDXFDialog;
label 999;
begin
  if Dial_Comp = nil then goto 999;
  StrPCopy(path, Exepath);

    { .SIM file save }
    Loadstring(HInstance, stW_SIMSauvTit+Lang, @TitleText, 79);
    MyFileDialog := New(PDXFDialog,Init(@Self, PChar(sd_FileSave), @TitleText, path));
    IF MyFileDialog <> nil then
      BEGIN
        if MyFileDialog^.Execute <> id_Ok then begin
          ier := hclose(gmf); goto 999; end;
        StrUpper(path);
        IF StrScan(path, '.') = NIL THEN 
          StrCat(path, '.SIM');
        FileSearch(dest, path, '');

        IF Dest[0] <> #0 THEN BEGIN
          Loadstring(HInstance, stW_BMPSavFex+Lang, @MessageText, 79);
          IF MessageBox(hWindow, MessageText, dest, mb_YesNo +
            mb_IconQuestion) <> IDYes THEN begin
          ier := hclose(gmf); goto 999; end;
        END;

    END;

  SimPath := StrPas(path);
  ier := Dial_Comp^.Spec_Save(SimPath);
  if ier = 0 then Sim_File := SimPath;
999:end;

procedure TScmpWindow.ChangeScale(var Msg: TMessage);
begin if Dial_Comp <> nil then Dial_Comp^.ChangeScale; end;

procedure TScmpWindow.Class_Compar(var Msg: TMessage);
begin if Dial_Comp <> nil then Dial_Comp^.Class_Compar; end;

PROCEDURE TScmpWindow.cmFileSaveAs(VAR Msg : TMessage);
BEGIN if Dial_Comp <> nil then Dial_Comp^.MetaFileSaveAs; end;

PROCEDURE TScmpWindow.cmEditCopy(VAR Msg : TMessage);
BEGIN if Dial_Comp <> nil then Dial_Comp^.ClipSaveAs; end;

end.